home *** CD-ROM | disk | FTP | other *** search
/ Software of the Month Club 1996 September / Software of the Month Club 1996 September.iso / mac / Software Research Institute-SRI / Business / Alpha ƒ / Tcl / SystemCode / menusLite.tcl < prev    next >
Encoding:
Text File  |  1996-01-05  |  6.7 KB  |  329 lines  |  [TEXT/ALFA]
  1. # My menus.        
  2.  
  3. menu -n File -p fileMenuProc {
  4.     "/Nnew"
  5.     "/Oopen╔"
  6.     {menu -m -n filesets {}}
  7.     "<S/Wclose"
  8.     "<S<I<O/WcloseAll"
  9.     "(-"
  10.     "<S/Ssave"
  11.     "<S<I<O/SsaveAll"
  12.     "<SsaveAs╔"
  13.     "revert"
  14.     "(-"
  15.     "pageSetup╔"
  16.     "/Pprint╔"
  17.     "(-"
  18.     "/Qquit"
  19. }
  20.  
  21. proc fileMenuProc {menu item} {
  22.     if {$item == "open"} {
  23.         findFile
  24.     } elseif {$item == "close"} {
  25.         killWindow
  26.     } else {
  27.         $item
  28.     }
  29. }
  30.  
  31. menu -n Edit {
  32.     "/Zundo"
  33.     "/Z<I<Oredo"
  34.     {menu -n emacs {}}
  35.     "(-"
  36.     "/X<Scut"
  37.     "/X<S<I<Ocut&Append"
  38.     "/C<Scopy"
  39.     "/C<S<I<Ocopy&Append"
  40.     "/V<Spaste"
  41.     "/V<S<I<OpastePop"
  42.     "/A<SselectAll"
  43.     "/A<S<I<OselectParagraph"
  44.     "clear"
  45.     "(-"
  46.     "/=selectLast"
  47.     "/`<Stwiddle"
  48.     "/`<S<I<OtwiddleWords"
  49. }
  50.  
  51. proc selectLast {} { markHilite }
  52.  
  53. #%     {/[<SshiftLeft}
  54. #%     {/[<S<I<OshiftLeftSpace}
  55. #%     {/]<SshiftRight}
  56. #%     {/]<S<I<OshiftRightSpace}
  57.  
  58.  
  59. menu -n Search {
  60.     "/F<Sfind╔"
  61.     "/F<S<I<OsearchStart"
  62.     "/G<SfindAgain"
  63.     "/G<S<I<OfindAgainBackward"
  64.     "/H<I<OfindInNextFile"
  65.     "/E<SenterSearchString"
  66.     "/E<S<I<OenterReplaceString"
  67.     "(-"
  68.     "/S<BquickFind"
  69.     "/R<BreverseQuickFind"
  70.     "(-"
  71.     "/R<Sreplace"
  72.     "/R<S<I<OreplaceAll"
  73.     "/Hreplace&FindAgain"
  74.     "(-"
  75.     "/,<BpushPosition"
  76.     "/.<BpopPosition"
  77.     "/G<IgotoLine"
  78. }
  79.  
  80. # ==== NOTE:  rectMarkHilite, onespace, centerRedraw, doTab
  81. menu -n Text {
  82.         "/I<SfillParagraph"
  83.         "/I<S<O<IwrapParagraph"
  84.         "/I<S<O<I<BsentenceParagraph"
  85.         "/U<S<OfillRegion"
  86.         "/U<S<I<OwrapRegion"
  87.         "<E<SupcaseRegion"
  88.         "<SdowncaseRegion"
  89.         "(-"
  90.         "<SreverseSort"
  91.         "<SsortLines"
  92.         "/L<I<OspellcheckWindow"
  93.         "zapInvisibles"
  94.         "<SspacesToTabs"
  95.         "<StabsToSpaces"
  96.         "(-"
  97.         "/D<ScommentLine"
  98.         "/D<S<I<OuncommentLine"
  99.         "<SuncommentBox"
  100.         "<ScommentBox"
  101.         "<S<EuncommentParagraph"
  102.         "<ScommentParagraph"
  103. }
  104.  
  105. proc strip {arg} {
  106.     if {[regsub -all {\\([][\{\}])} $arg {\1} v]} {return $v}
  107.     return $arg
  108. }
  109.  
  110. #===============================================================================
  111. proc helpMenu {item} {
  112.     global HOME
  113.     edit -r "$HOME:Help:$item"
  114. }
  115. set men { "Quick Start" "Readme" "Changes" "(-" }
  116.  
  117. foreach f [lsort -ignore [glob "$HOME:Help:*"]] {
  118.     set f [file tail $f]
  119.     if {[lsearch $men $f] < 0} {
  120.         lappend men $f
  121.     }
  122. }
  123. foreach f $men {
  124.     addHelpMenu $f
  125. }
  126. unset men
  127. #===============================================================================
  128.  
  129.  
  130. proc escapeSpaces {str} {
  131.     regsub -all { } $str {\ } str2
  132.     return $str2
  133. }
  134.  
  135.  
  136. proc buildSwitches {} {
  137.     global switchApps
  138.     
  139.     menu -m -n switchTo -p switchProc {"<O<I/NNow╔" "Add╔" "Remove╔" "(-"}
  140.  
  141.     if {[info exists switchApps] && [llength $switchApps]} {
  142.         foreach app $switchApps {
  143.             lappend names [file tail $app]
  144.         }
  145.         foreach name [lsort -ignore $names] {
  146.             addMenuItem -m -l "blah" switchTo $name
  147.         }
  148.     }
  149. }
  150.  
  151.  
  152. proc switchProc {menu name} {
  153.     global switchTo switchApps
  154.  
  155.     if {$name == "Add"} {
  156.         set fname [getfile "Pick an app:"]
  157.         lappend switchApps $fname
  158.         addDef switchApps $switchApps
  159.         buildSwitches
  160.     } elseif {$name == "Remove"} {
  161.         foreach app $switchApps {
  162.             lappend apps [file tail $app]
  163.         }
  164.         set name [listpick -p "Remove which app?" $apps]
  165.         if {[set ind [lsearch $switchApps "*$name"]] >= 0} {
  166.             set switchApps [lreplace $switchApps $ind $ind]
  167.             addDef switchApps $switchApps
  168.             buildSwitches
  169.         }
  170.     } elseif {$name == "Now"} {
  171.         switchApp
  172.     } else {
  173.         if {[set ind [lsearch $switchApps "*$name"]] >= 0} {
  174.             if {[catch {switchTo $name}]} {
  175.                 launch -f [lindex $switchApps $ind]
  176.             }
  177.         }
  178.     }
  179. }
  180.         
  181.  
  182. proc winTileProc {menu item} {
  183.     win$item
  184. }
  185.  
  186.  
  187. menu -n $winMenu -p menuWin {
  188.         "//<SsinglePage"
  189.         "//<Szoom"
  190.         "<S/;chooseAWindow"
  191.         "/Y<O<Iiconify"
  192.         {menu -n arrange -p winTileProc {
  193.             "/Jvertically^1"
  194.             "/J<O<Ihorizontally^2"
  195.             "tiled^3"
  196.             "overlay^4"
  197.             "(-"
  198.             }}
  199.         {menu -s -n mode -p editModeFlag {}}
  200.         "(-"
  201.         "/isetFontsTabs╔"
  202.         "/jsplitWindow"
  203.         "/ktoggleSoftWrap"
  204.         "/ltoggleScrollbar"
  205.         "(-"
  206. }
  207.  
  208. # We may be reloading, so add whatever windows we have
  209. if {[info exists winNameToNum]} {
  210.     set nms [array names winNameToNum]
  211.     foreach name $nms {
  212.         regexp {[^:]*$} $name item
  213.         set num $winNameToNum($name)
  214.         if {$num < 10}     {
  215.             addMenuItem -m $winMenu /$num$item
  216.         } else {
  217.             addMenuItem -m $winMenu $item
  218.         }
  219.     }
  220. }
  221.  
  222. insertMenu "File"
  223. insertMenu "Edit"
  224. insertMenu "Search"
  225. insertMenu "Text"
  226. catch {enableMenuItem NamedClipboards paste off}
  227. menu -n $fsetMenuName {}; 
  228. insertMenu $winMenu
  229.  
  230. # catch {insertMenu $helpMenu}
  231.  
  232.  
  233. menu -n $toolserverMenu {}
  234.  
  235.  
  236. #===============================================================================
  237. # Stuff that needs to be here for AlphaLite.
  238. #===============================================================================
  239. proc rebuildTclIndices {} {
  240.     global auto_path
  241.     set d [pwd]
  242.     # do we really need the next line? Alpha's original uses it.
  243.     cd
  244.     foreach dir $auto_path {
  245.         # if directory exists
  246.         if { ![catch { cd $dir } ] } {
  247.             # if there are any files
  248.             if { ![catch { glob *.*tcl } ] } {
  249.                 message "Building [file tail $dir] index╔"
  250.                 
  251.                 # if the '[incr tcl]' version exists, use that
  252.                 # use 'catch' also in case directory is write-protected
  253.                 if [catch { itcl_mkindex : *.*tcl } ] {
  254.                     # else try the normal one
  255.                     catch { auto_mkindex : *.*tcl }
  256.                 }
  257.             }
  258.         }
  259.     }
  260.     # redo the auto-mode-file connections (see "smarterSource.tcl")
  261.     message "Building the mode-file dependency array"
  262.     catch {autoModeFiles}
  263.     message ""
  264.     cd $d
  265. }
  266. proc traceTclProc {} {
  267.     global tclMenu
  268.     if {[llength [traceFunc status]]>2} {
  269.         catch {markMenuItem $tclMenu {traceTclProc╔} off}
  270.         catch {enableMenuItem $tclMenu dumpTraces off}
  271.         if {[string length [set data [traceDump]]]} {
  272.             if {[askyesno "Dump traces?"] == "yes"} {
  273.                 dumpTraces [string trimright [lindex [traceFunc status] 3] {,}] $data
  274.                 setWinInfo dirty 0
  275.             }
  276.         }
  277.         traceFunc off
  278.         message "Tracing off."
  279.         return
  280.     }
  281.     if {[llength [winNames]] && [string length [set sel [getSelect]]]} {
  282.         set func [listpick -L $sel -p {Func Name:} [lsort -ignore [info procs]]]
  283.     } else {
  284.         set func [listpick -p {Func Name:} [lsort -ignore [info procs]]]
  285.     }
  286.     if {![string length $func]} return
  287.     traceFunc on $func ""
  288.     catch {markMenuItem $tclMenu {traceTclProc╔} on}
  289.     catch {enableMenuItem $tclMenu dumpTraces on}
  290.     message "Tracing '$func'╔"
  291. }
  292.  
  293.  
  294. proc dumpTraces {{name ""} {data ""}} {
  295.     if {![string length $name]} {
  296.         set name [string trimright [lindex [traceFunc status] 3] {,}]
  297.     }
  298.     if {![string length $data]} {
  299.         set data [traceDump]
  300.     }
  301.     
  302.     if {![string length $data]} {
  303.         message "Trace buffer empty"
  304.     } else {
  305.         new -n "* Trace '$name' *"
  306.         insertText $data
  307.         setWinInfo dirty 0
  308.         goto 0 
  309.     }
  310. }
  311. proc carriageReturn {} {
  312.     global mode
  313.     global indentOnCR
  314.     set indentString ""
  315.     deleteText [getPos] [selEnd]
  316.     if {$indentOnCR} {
  317.         set pos [getPos]
  318.         set text [getText [lineStart $pos] $pos]
  319.         for {set i 0; set len [string length $text]} {$i <= $len} {incr i} {
  320.             set c [string index $text $i]
  321.             if {($c != "\t") && ($c != "\ ")} {
  322.                 set indentString [string range $text 0 [expr $i-1]]
  323.                 break
  324.             }
  325.         }
  326.     }
  327.     insertText "\r" $indentString
  328. }
  329.